perm filename FOO.MCL[206,LSP] blob
sn#281495 filedate 1977-05-07 generic text, type C, neo UTF8
COMMENT ā VALID 00009 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,1
C00006 00003 1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,1
C00009 00004 1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,1
C00012 00005 1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,2
C00016 00006 1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,2
C00019 00007 1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,2
C00022 00008 1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,2
C00025 00009 1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,2
C00027 ENDMK
Cā;
1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,1
**** File 1) LCOM0[206,LSP], Page 1 line 3
1) (DEFPROP COMPFCNS
1) (NIL COMPL
1) COMP
1) PRUP
1) MKPUSH
1) COMPEXP
1) COMPLIS
1) LOADAC
1) COMCOND
1) COMBOOL
1) COMPANDOR)
1) VALUE)
1) (DEFPROP COMPL
1) (LAMBDA(FILE)
1) (PROG (Z)
1) (EVAL
1) (CONS (QUOTE OUTPUT)
1) (CONS (QUOTE DSK:)
1) (LIST (CONS (CAR FILE) (QUOTE LAP))))))
1) (EVAL (CONS (QUOTE INPUT) (CONS (QUOTE DSK:) FILE)))
1) (INC (QUOTE T) NIL)
1) (OUTC T NIL)
1) LOOP (SETQ Z (ERRSET (READ)))
1) (COND ((ATOM Z) (GO DONE)) ((QUOTE T) (QUOTE NIL)))
1) (SETQ Z (CAR Z))
1) (COND ((EQ (CAR Z) (QUOTE DE))
1) (PROG (PROG)
1) (SETQ PROG (COMP (CADR Z) (CADDR Z) (CADDDR Z)))
1) (MAPC (FUNCTION PRINT) PROG)
1) (OUTC NIL NIL)
1) (PRINT (LIST (CADR Z) (LENGTH PROG)))
1) (OUTC T NIL)))
1) (T (PRINT Z)))
1) (GO LOOP)
1) DONE (OUTC NIL T)
1) (INC NIL T)
1) (RETURN (QUOTE ENDCOMP))))
1) FEXPR)
1) (DEFPROP COMP
1) (LAMBDA(FN VARS EXP)
1) ((LAMBDA(N)
**** File 2) LCOM0.MCL[206,LSP], Page 1 line 1
2) COMMENT ā VALID 00002 PAGES
2) C REC PAGE DESCRIPTION
2) C00001 00001
2) C00002 00002 (DECLARE (SETQ NO-DISK-HACKS T))
2) C00015 ENDMK
1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,1
2) Cā;
2) (DECLARE (SETQ NO-DISK-HACKS T))
2) (DECLARE (REQUIRE UTIL 1 DSK (AID RPG)))
2) (DECLARE (READ))
2) (REQUIRE UTIL 1 DSK (AID RPG))
2) (DEFPROP LC0FNS
2) (LC0FNS COMPL
2) COMP
2) PRUP
2) MKPUSH
2) COMPEXP
2) COMPLIS
2) LOADAC
2) COMCOND
2) COMBOOL
2) COMPANDOR)
2) VALUE)
2) ;COMPL is the user-callable driver. It is a FEXPR. It takes as
2) ; an argument a single file name, e.g (COMPL FOO BAR DSK (FOO BAR))
2) ; EXPRs on a file called FILNAM will be compiled into LAP and
2) ; written on the file FILNAM.LAP. Other types of function
2) ; definitions and non-definitions are simply copied to output.
2) (DEFUN FEXPR COMPL(FILE)
2) (UWRITE) ;Open a file for output
2) (APPLY 'EREAD FILE) ;Open input file
2) (SELECT-DISK-INPUT
2) (READ-UNTIL-EOF WITH Z DO ;Read each expression in file
2) (COND ((OR (EQ (CAR Z) (QUOTE DEFUN))
2) (AND (EQ (CAR Z) (QUOTE DEFPROP))
2) (EQ (CADDDR Z) (QUOTE EXPR))))
2) (PROG (PROG)
2) (SETQ PROG
2) (COND ((EQ (CAR Z) (QUOTE DEFUN))
2) (COMP (CADR Z)
2) (CADDR Z)
2) (CADDDR Z)))
2) (T
2) (COMP (CADR Z)
2) (CADR (CADDR Z))
2) (CADDR (CADDR Z))))))
2) ;;; Print out code in file
2) (UNSELECT-TTY (SELECT-DISK-OUTPUT (MAPC (FUNCTION PRINT) PROG)))
2) (PRINT (LIST (CADR Z) (LENGTH PROG)))))
2) (T (UNSELECT-TTY (SELECT-DISK-OUTPUT (PRINT Z))))))
2) (APPLY 'UFILE (LIST (CAR FILE) 'LAP)) ;Close and rename file
2) (QUOTE ENDCOMP)))
2) ;COMP compiles a single function definition, returning a list of
2) ; the LAP code corresponding to the definition.
1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,1
2) ; FN is the atomic name of the function being compiled.
2) ; VARS is the formal parameter list for the function.
2) ; EXP is the function body.
2) (DEFUN COMP(FN VARS EXP)
2) ((LAMBDA(N)
***************
**** File 1) LCOM0[206,LSP], Page 1 line 50
1) (LIST (QUOTE SUB) (QUOTE P) (LIST (QUOTE C) N 0 N 0)))
1) (QUOTE ((POPJ P) NIL))))
1) (LENGTH VARS)))
1) EXPR)
1) (DEFPROP PRUP
1) (LAMBDA(VARS N)
1) (COND ((NULL VARS) NIL)
1) (T (CONS (CONS (CAR VARS) N) (PRUP (CDR VARS) (PLUS N 1))))))
1) EXPR)
1) (DEFPROP MKPUSH
1) (LAMBDA(N M)
1) (COND ((LESSP N M) NIL)
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 61
2) ;;; Maclisp change from (sub p (e 0 n 0 n)) to (sub p (% 0 0 n n))
2) (LIST (QUOTE SUB) (QUOTE P) (LIST (QUOTE %) 0 0 N N)))
2) (QUOTE ((POPJ P) NIL))))
2) (LENGTH VARS)))
2) ;PRUP returns an A-LIST formed by pairing successive elements of
2) ; VARS with consecutive integers beginning with N.
2) (DEFUN PRUP(VARS N)
2) (COND ((NULL VARS) NIL)
2) (T (CONS (CONS (CAR VARS) N) (PRUP (CDR VARS) (ADD1 N))))))
2) ;MKPUSH returns a list of N (PUSH P i) instructions, where i runs
2) ; from M to M+N-1. Used to push arguments onto the stack.
2) (DEFUN MKPUSH(N M)
2) (COND ((LESSP N M) NIL)
***************
**** File 1) LCOM0[206,LSP], Page 1 line 66
1) (MKPUSH N (PLUS M 1))))))
1) EXPR)
1) (DEFPROP COMPEXP
1) (LAMBDA(EXP M VPR)
1) (COND ((NULL EXP) (QUOTE ((MOVEI 1 0))))
1) ((EQ EXP (QUOTE T)) (QUOTE ((MOVEI 1 (QUOTE T)))))
1) ((ATOM EXP)
1) (LIST
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 80
1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,2
2) (MKPUSH N (ADD1 M))))))
2) ;COMPEXP is the heart of LCOM0. It determines precisely
2) ; what an expression is, and compiles appropriate code
2) ; for it. It returns a list of that code.
2) ; EXP is the expression to be compiled.
2) ; M is minus the number of entries on the stack. When
2) ; added to a value retrieved from the A-LIST VPR, it
2) ; can be used to locate a variable on the stack.
2) ; VPR is an A-LIST, associating variable names with
2) ; numbers which, when added to M, give stack offsets.
2) ; Both M and VPR maintain these definitions throughout.
2) (DEFUN COMPEXP(EXP M VPR)
2) (COND ((NULL EXP) (QUOTE ((MOVEI 1 0)))) ;NIL
2) ((EQ EXP T) (QUOTE ((MOVEI 1 (QUOTE T))))) ;T
2) ;;; This wasn't here in 1.6 lcom0
2) ((NUMBERP EXP) ;number
2) (LIST
2) (LIST (QUOTE MOVEI)
2) 1
2) (LIST 'QUOTE EXP))))
2) ((ATOM EXP) ;variable
2) (LIST
***************
**** File 1) LCOM0[206,LSP], Page 1 line 79
1) ((OR (EQ (CAR EXP) (QUOTE AND))
1) (EQ (CAR EXP) (QUOTE OR))
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 113
2) ((OR (EQ (CAR EXP) (QUOTE AND)) ;boolean expression
2) (EQ (CAR EXP) (QUOTE OR))
***************
**** File 1) LCOM0[206,LSP], Page 1 line 92
1) ((EQ (CAR EXP) (QUOTE COND))
1) (COMCOND (CDR EXP) M (GENSYM) VPR))
1) ((EQ (CAR EXP) (QUOTE QUOTE))
1) (LIST (LIST (QUOTE MOVEI) 1 EXP)))
1) ((ATOM (CAR EXP))
1) ((LAMBDA(N)
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 127
2) ((EQ (CAR EXP) (QUOTE COND)) ;COND
2) (COMCOND (CDR EXP) M (GENSYM) VPR))
2) ((EQ (CAR EXP) (QUOTE QUOTE)) ;QUOTE
2) (LIST (LIST (QUOTE MOVEI) 1 EXP)))
2) ((ATOM (CAR EXP)) ;function call
2) ((LAMBDA(N)
1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,2
***************
**** File 1) LCOM0[206,LSP], Page 1 line 102
1) (LIST (QUOTE SUB) (QUOTE P) (LIST (QUOTE C) N 0 N 0)))
1) (LIST
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 139
2) (LIST (QUOTE SUB) (QUOTE P) (LIST (QUOTE %) 0 0 N N)))
2) (LIST
***************
**** File 1) LCOM0[206,LSP], Page 1 line 106
1) (LIST (QUOTE E) (CAR EXP))
1) (QUOTE S)))))
1) (LENGTH (CDR EXP))))
1) ((EQ (CAAR EXP) (QUOTE LAMBDA))
1) ((LAMBDA(N)
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 143
2) ;;; Change from (call n (e foo) s) to (call n 'foo)
2) (LIST 'QUOTE (CAR EXP))
2) ))))
2) (LENGTH (CDR EXP))))
2) ((EQ (CAAR EXP) (QUOTE LAMBDA)) ;LAMBDA expression
2) ((LAMBDA(N)
***************
**** File 1) LCOM0[206,LSP], Page 1 line 118
1) (LIST (QUOTE SUB) (QUOTE P) (LIST (QUOTE C) N 0 N 0)))))
1) (LENGTH (CDR EXP))))
1) ((QUOTE T) (QUOTE NIL))))
1) EXPR)
1) (DEFPROP COMPLIS
1) (LAMBDA(U M VPR)
1) (COND ((NULL U) NIL)
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 157
2) (LIST (QUOTE SUB) (QUOTE P) (LIST (QUOTE %) 0 0 N N)))))
2) (LENGTH (CDR EXP))))
2) (T NIL))) ;oops
2) ;COMPLIS compiles code to evaluate each expression in a list of
2) ; expressions and to push those values onto the stack. It
2) ; returns a list of that code. It is used to compile code
2) ; to evaluate arguments to called functions or LAMBDA expressions.
2) ; U is a list of expressions.
2) (DEFUN COMPLIS (U M VPR)
2) (COND ((NULL U) NIL)
***************
1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,2
**** File 1) LCOM0[206,LSP], Page 1 line 129
1) (COMPLIS (CDR U) (DIFFERENCE M 1) VPR)))))
1) EXPR)
1) (DEFPROP LOADAC
1) (LAMBDA(N K)
1) (COND ((GREATERP N 0) NIL)
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 173
2) (COMPLIS (CDR U) (SUB1 M) VPR)))))
2) ;LOADAC returns a list of (MOVE i j P) instructions, loading
2) ; consecutive accumulators from the top of the stack.
2) ; K indexes the accumulator loaded.
2) ; N indexes the stack offset.
2) (DEFUN LOADAC (N K)
2) (COND ((GREATERP N 0) NIL)
***************
**** File 1) LCOM0[206,LSP], Page 1 line 137
1) (LOADAC (PLUS N 1) (PLUS K 1))))))
1) EXPR)
1) (DEFPROP COMCOND
1) (LAMBDA(U M L VPR)
1) (COND ((NULL U) (LIST L))
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 184
2) (LOADAC (ADD1 N) (ADD1 K))))))
2) ;COMCOND compiles a COND.
2) ; U is a list of clauses in the COND.
2) ; L is a label to be emitted at the end of all code for
2) ; the COND.
2) (DEFUN COMCOND(U M L VPR)
2) (COND ((NULL U) (LIST L))
***************
**** File 1) LCOM0[206,LSP], Page 1 line 147
1) (LIST (LIST (QUOTE JRST) L) L1)
1) (COMCOND (CDR U) M L VPR)))
1) (GENSYM)))))
1) EXPR)
1) (DEFPROP COMBOOL
1) (LAMBDA(P M L FLG VPR)
1) (COND ((ATOM P)
1) (APPEND
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 197
2) (LIST (LIST (QUOTE JRST) 0 L) L1)
2) (COMCOND (CDR U) M L VPR)))
1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,2
2) (GENSYM)))))
2) ;COMBOOL compiles code for a single predicate. That is, the
2) ; code generated evaluates the predicate and branches somewhere,
2) ; depending on the value.
2) ; P is the predicate.
2) ; L is a label which represents the branch point.
2) ; FLG is a flag. If FLG is NIL, code is to fall thru on non-NIL
2) ; result and branch to L on NIL result. If FLG is non-NIL,
2) ; code is to fall thru on NIL result and branch to L on
2) ; non-NIL result.
2) (DEFUN COMBOOL(P M L FLG VPR)
2) (COND ((ATOM P) ;simple variable
2) (APPEND
***************
**** File 1) LCOM0[206,LSP], Page 1 line 159
1) ((EQ (CAR P) (QUOTE AND))
1) (COND ((NOT FLG) (COMPANDOR (CDR P) M L NIL VPR))
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 218
2) ((EQ (CAR P) (QUOTE AND)) ;conjunction
2) (COND ((NOT FLG) (COMPANDOR (CDR P) M L NIL VPR))
***************
**** File 1) LCOM0[206,LSP], Page 1 line 167
1) ((EQ (CAR P) (QUOTE OR))
1) (COND (FLG (COMPANDOR (CDR P) M L T VPR))
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 227
2) ((EQ (CAR P) (QUOTE OR)) ;disjunction
2) (COND (FLG (COMPANDOR (CDR P) M L T VPR))
***************
**** File 1) LCOM0[206,LSP], Page 1 line 175
1) ((EQ (CAR P) (QUOTE NOT))
1) (COMBOOL (CADR P) M L (NOT FLG) VPR))
1) (T
1) (APPEND
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 236
2) ((EQ (CAR P) (QUOTE NOT)) ;negation
2) (COMBOOL (CADR P) M L (NOT FLG) VPR))
2) (T ;other expression
2) (APPEND
***************
**** File 1) LCOM0[206,LSP], Page 1 line 184
1) LCOM0[206,LSP] and 2) LCOM0.MCL[206,LSP] 5-07-77 16:11 pages 1,2
1) EXPR)
1) (DEFPROP COMPANDOR
1) (LAMBDA(U M L FLG VPR)
1) (COND ((NULL U) NIL)
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 247
2) ;COMPANDOR compiles code for lists of predicates connected
2) ; conjunctively or disjunctively.
2) ; U is a list of predicates.
2) ; L is a label.
2) ; FLG is a flag. If FLG is NIL, we are to fall thru on non-NIL
2) ; results and branch to L on NIL results (AND case). If FLG
2) ; is non-NIL, we are to fall thru on NIL results and branch
2) ; to L on non-NIL results (OR case).
2) (DEFUN COMPANDOR(U M L FLG VPR)
2) (COND ((NULL U) NIL)
***************
**** File 1) LCOM0[206,LSP], Page 1 line 192
1) EXPR)
**** File 2) LCOM0.MCL[206,LSP], Page 2 line 261
***************